home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE16 / RTTI / CTypInfo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-27  |  8.8 KB  |  258 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {       Copyright (c) 1995,96 Borland International     }
  5. {                                                       }
  6. {*******************************************************}
  7. {                                                       }
  8. {       With comments added by Marco Cant∙ for          }
  9. {       the book "Delphi Developer's Handbook"          }
  10. {       Last updated August 31, 1996                    }
  11. {                                                       }
  12. {*******************************************************}
  13.  
  14. unit TypInfo;
  15.  
  16. interface
  17.  
  18. uses SysUtils;
  19.  
  20. type
  21.  
  22. { Datatype-related enumerations and sets used by the unit... }
  23.  
  24.   TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
  25.     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkLWString,
  26.     tkVariant);
  27.   TTypeKinds = set of TTypeKind;
  28.  
  29.   TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong);
  30.  
  31.   TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
  32.  
  33.   TMethodKind = (mkProcedure, mkFunction);
  34.   TParamFlags = set of (pfVar, pfConst, pfArray);
  35.  
  36.  
  37. {-----------------------------}
  38. {    TTypeInfo - PTypeInfo    }
  39. {-----------------------------}
  40.  
  41.   {PTypeInfo is the type returned by the TObject.ClassInfo method
  42.   and by: function TypeInfo(TypeIdent): Pointer;
  43.  
  44.   To access the TypeData member you can simply use the
  45.   GetTypeData function (which simply increases the pointer)}
  46.  
  47.   PTypeInfo = ^TTypeInfo; // a pointer to TTypeInfo
  48.   TTypeInfo = record
  49.     Kind: TTypeKind;
  50.     Name: ShortString;
  51.    {TypeData: TTypeData}
  52.   end;
  53.  
  54.  
  55. {-----------------------------}
  56. {    TTypeData - PTypeData    }
  57. {-----------------------------}
  58.  
  59.   {PTypeData is the pointer returned by the GetTypeData
  60.   function. This basically returns a pointer the TypeData
  61.   area of the TTypeINfo record.
  62.  
  63.   You can use this structure directly to get TTypeKind-dependent
  64.   information. Notice that this variant record is multi-level!
  65.   This is not the original version, but a "more readable one"}
  66.  
  67.   PTypeData = ^TTypeData; // a pointer to TTypeData
  68.   TTypeData = packed record
  69.     case TTypeKind of
  70.       tkUnknown: ();  // no information
  71.       tkLString: ();  // no information
  72.       tkLWString: ();  // no information
  73.       tkVariant: ();  // no information
  74.       tkInteger: (
  75.         OrdType: TOrdType;
  76.         // otSByte, otUByte, otSWord, otUWord, otSLong;
  77.         MinValue: Longint;
  78.         MaxValue: Longint);
  79.       tkChar, tkWChar: (
  80.         OrdType: TOrdType;
  81.         // otSByte, otUByte, otSWord, otUWord, otSLong;
  82.         MinValue: Longint;
  83.         MaxValue: Longint);
  84.       tkEnumeration: (
  85.         OrdType: TOrdType;
  86.         // otSByte, otUByte, otSWord, otUWord, otSLong;
  87.         MinValue: Longint;
  88.         MaxValue: Longint;
  89.         BaseType: PTypeInfo;
  90.         // the original type definition
  91.         NameList: ShortString);
  92.         // the enumeration names (see GetEnumName)
  93.       tkSet: (
  94.         OrdType: TOrdType;
  95.         // otSByte, otUByte, otSWord, otUWord, otSLong;
  96.         CompType: PTypeInfo);
  97.         // the enumerated type the set is built from
  98.       tkFloat: (
  99.         FloatType: TFloatType);
  100.         // ftSingle, ftDouble, ftExtended, ftComp, ftCurr
  101.       tkString: (
  102.         MaxLength: Byte);
  103.       tkClass: (
  104.         ClassType: TClass;
  105.         // the class reference
  106.         ParentInfo: PTypeInfo;
  107.         // the parent type information
  108.         PropCount: SmallInt;
  109.         // the number of properties
  110.         UnitName: ShortString
  111.         // the unit defining the class type
  112.        {PropData: TPropData});
  113.        // the properties data: to access this information
  114.        // call procedure GetPropInfos or function GetPropList
  115.       tkMethod: (
  116.         MethodKind: TMethodKind;
  117.         // mkProcedure, mkFunction
  118.         ParamCount: Byte;
  119.         // the number of parameters
  120.         ParamList: array[0..1023] of Char
  121.         // the parameters list, better described as:
  122.        {ParamList: array[1..ParamCount] of
  123.           record
  124.             Flags: TParamFlags;
  125.             // TParamFlags = set of (pfVar, pfConst, pfArray);
  126.             ParamName: ShortString;
  127.             TypeName: ShortString;
  128.           end;
  129.         ResultType: ShortString});
  130.         // the return type
  131.   end;
  132.  
  133.   {The TPropData structure, used in the TTypeData
  134.   structure above is seldom used. Gives an idea of the
  135.   contents of the TTypeData for classes}
  136.  
  137.   TPropData = packed record
  138.     PropCount: Word;
  139.     PropList: record end;
  140.    {PropList: array[1..PropCount] of TPropInfo}
  141.   end;
  142.  
  143. {-----------------------------}
  144. {    TPropInfo - PPropInfo    }
  145. {-----------------------------}
  146.  
  147.   {PPropInfo is the pointer returned by the
  148.   GetPropInfo function. The GetPropInfos procedure,
  149.   instead, fills a list of such pointer (see later on).
  150.  
  151.   This structure reveals a lot of information
  152.   about properties including a pointer to the
  153.   type information, the pointers to the procedures
  154.   used to operate on the property, and the name}
  155.  
  156.   PPropInfo = ^TPropInfo;
  157.   TPropInfo = packed record
  158.     PropType: PTypeInfo; // property type RTTI
  159.     GetProc: Pointer; // read method
  160.     SetProc: Pointer; // write method
  161.     StoredProc: Pointer; // store method
  162.     Index: Integer; // property index
  163.     Default: Longint; // default value (odd type)
  164.     NameIndex: SmallInt; // index of the name
  165.     Name: ShortString; // name
  166.   end;
  167.  
  168.   // seems to be the parameter of an enumerated function
  169.   // but it is not used anywhere in the VCL source...
  170.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  171.  
  172. {-----------------------------}
  173. {    TPropList - PPropList    }
  174. {-----------------------------}
  175.  
  176.   {TPropList is a list of pointers to properties RTTI
  177.   information. PPropList is a pointer to the list of pointers}
  178.  
  179.   PPropList = ^TPropList;
  180.   TPropList = array[0..16379] of PPropInfo;
  181.  
  182. const
  183.   // predefined filters for the GetPropList function
  184.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  185.   tkMethods = [tkMethod];
  186.   tkProperties = tkAny - tkMethods - [tkUnknown];
  187.  
  188.  
  189. {-----------------------------}
  190. {    Generic RTTI Routines    }
  191. {-----------------------------}
  192.  
  193. {GetTypeData returns the pointer to the type data from the
  194. TTypeInfo structure the parameters points to. This code is
  195. required to skip the variable-length string}
  196. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  197.  
  198. {funtions accessing to the NameList field of the
  199. TTypeData structure for enumerated data types. Basically
  200. extracts substrings from a packed list of variable
  201. length strings}
  202. function GetEnumName(TypeInfo: PTypeInfo;
  203.   Value: Integer): string;
  204. function GetEnumValue(TypeInfo: PTypeInfo;
  205.   const Name: string): Integer;
  206.  
  207. {GetPropInfo extracts the PProfInfo pointer for a specific
  208. property passed by name. The code looks into the PropData field
  209. of the TTypeData structure for classes.}
  210. function GetPropInfo(TypeInfo: PTypeInfo;
  211.   const PropName: string): PPropInfo;
  212.  
  213. {These functions fill the PropList parameter with a list of
  214. pointers to properties RTTI information. GetPropInfos returns
  215. all of the properties, while GetPropList allows you to specify
  216. a filter on the kind of properties you are interested in}
  217. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  218. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  219.   PropList: PPropList): Integer;
  220.  
  221. // helper ruotine returning whether the property is stored
  222. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  223.  
  224. {--------------------------------}
  225. {    Property Access Routines    }
  226. {--------------------------------}
  227.  
  228. {The following routines are used to read or write a property
  229. of a given "kind" of data type. Each routine has an Instance
  230. parameter, the pointer to the object, and a PProfInfo parameter
  231. related to the property you want to access to. Then the SetXxx
  232. procedures require the new value, while the GetXxx functions
  233. return the current one}
  234.  
  235. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  236. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  237.   Value: Longint);
  238.  
  239. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  240. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  241.   const Value: string);
  242.  
  243. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  244. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  245.   Value: Extended);
  246.  
  247. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  248. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  249.   const Value: Variant);
  250.  
  251. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  252. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  253.   const Value: TMethod);
  254.  
  255. implementation
  256.  
  257. end.
  258.